Загрузка данных

hogwarts <- read_csv("data/hogwarts_2024.csv")
hogwarts |> head()
## # A tibble: 6 × 60
##      id house    course sex   wandCore bloodStatus result Defence against the …¹
##   <dbl> <chr>     <dbl> <chr> <chr>    <chr>        <dbl>                  <dbl>
## 1     1 Ravencl…      4 fema… unicorn… half-blood      94                     73
## 2     2 Hufflep…      5 male  phoenix… half-blood      33                     38
## 3     3 Ravencl…      4 fema… dragon … half-blood     137                     52
## 4     4 Hufflep…      2 male  phoenix… half-blood      27                     50
## 5     5 Hufflep…      2 fema… phoenix… half-blood      67                     47
## 6     6 Gryffin…      6 male  phoenix… muggle-born    126                     44
## # ℹ abbreviated name: ¹​`Defence against the dark arts exam`
## # ℹ 52 more variables: `Flying exam` <dbl>, `Astronomy exam` <dbl>,
## #   `Herbology exam` <dbl>, `Divinations exam` <dbl>, `Charms exam` <dbl>,
## #   `History of magic exam` <dbl>, `Arithmancy exam` <dbl>,
## #   `Care of magical creatures exam` <dbl>, `Muggle studies exam` <dbl>,
## #   `Study of ancient runes exam` <dbl>, `Transfiguration exam` <dbl>,
## #   `Potions exam` <dbl>, week_1 <dbl>, week_2 <dbl>, week_3 <dbl>, …

Проверка структуры данных

hogwarts |> glimpse()
## Rows: 560
## Columns: 60
## $ id                                   <dbl> 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11…
## $ house                                <chr> "Ravenclaw", "Hufflepuff", "Raven…
## $ course                               <dbl> 4, 5, 4, 2, 2, 6, 7, 5, 2, 3, 7, …
## $ sex                                  <chr> "female", "male", "female", "male…
## $ wandCore                             <chr> "unicorn hair", "phoenix feather"…
## $ bloodStatus                          <chr> "half-blood", "half-blood", "half…
## $ result                               <dbl> 94, 33, 137, 27, 67, 126, 63, 7, …
## $ `Defence against the dark arts exam` <dbl> 73, 38, 52, 50, 47, 44, 51, 47, 2…
## $ `Flying exam`                        <dbl> 33, 36, 73, 42, 41, 52, 34, 34, 2…
## $ `Astronomy exam`                     <dbl> 57, 45, 66, 49, 57, 59, 58, 37, 5…
## $ `Herbology exam`                     <dbl> 73, 50, 62, 39, 38, 46, 59, 23, 2…
## $ `Divinations exam`                   <dbl> 66, 54, 72, 42, 47, 49, 42, 38, 1…
## $ `Charms exam`                        <dbl> 60, 70, 77, 46, 35, 55, 86, 20, 4…
## $ `History of magic exam`              <dbl> 52, 36, 60, 45, 50, 40, 55, 21, 2…
## $ `Arithmancy exam`                    <dbl> 61, 36, 58, 32, 76, 50, 41, 31, 2…
## $ `Care of magical creatures exam`     <dbl> 44, 41, 70, 36, 46, 73, 29, 36, 4…
## $ `Muggle studies exam`                <dbl> 64, 34, 52, 59, 50, 54, 36, 31, 4…
## $ `Study of ancient runes exam`        <dbl> 50, 35, 59, 39, 48, 56, 47, 41, 3…
## $ `Transfiguration exam`               <dbl> 74, 70, 70, 15, 32, 86, 100, 31, …
## $ `Potions exam`                       <dbl> 67, 38, 22, 64, 56, 60, 62, 55, 1…
## $ week_1                               <dbl> 0, -5, 0, -1, 1, 5, 1, -20, 3, -2…
## $ week_2                               <dbl> -10, 1, 0, 5, 20, 10, -5, 10, 1, …
## $ week_3                               <dbl> 0, -1, 1, -5, 10, -5, 3, -5, -3, …
## $ week_4                               <dbl> 10, 1, -1, 10, -10, 10, 0, -10, -…
## $ week_5                               <dbl> 3, -5, 3, 0, -1, 20, 5, 5, -3, 5,…
## $ week_6                               <dbl> -20, 20, 0, 0, 0, 0, 0, 5, 0, -1,…
## $ week_7                               <dbl> 10, 10, 1, -3, -20, 1, 10, 3, -5,…
## $ week_8                               <dbl> 5, 5, 1, -5, 5, 5, 0, 1, 0, 20, -…
## $ week_9                               <dbl> 1, 1, 3, -1, 0, 3, -20, -20, -10,…
## $ week_10                              <dbl> 20, -10, 1, 5, -1, 0, 5, -5, 5, 3…
## $ week_11                              <dbl> 5, -10, 20, 0, 0, 0, 5, 10, 5, 5,…
## $ week_12                              <dbl> 5, -5, 1, -20, -10, -5, 0, 5, 1, …
## $ week_13                              <dbl> -20, -5, 10, 0, 0, 1, -1, 10, -20…
## $ week_14                              <dbl> 0, 5, 3, 10, -10, 20, 0, -20, -20…
## $ week_15                              <dbl> 1, 20, 1, 0, -20, 10, 1, 3, -20, …
## $ week_16                              <dbl> 20, 5, 5, 5, 0, 3, 10, -1, 5, 5, …
## $ week_17                              <dbl> 3, 0, 10, 5, 5, -5, -1, 10, -10, …
## $ week_18                              <dbl> 10, 5, 5, 5, 10, -20, 0, 10, 3, 5…
## $ week_19                              <dbl> -10, 0, -5, -1, 0, -1, 0, 20, 0, …
## $ week_20                              <dbl> 10, -10, 5, 10, 0, -1, -1, 10, 0,…
## $ week_21                              <dbl> 0, 5, 5, 3, 5, 0, 0, -5, -5, 5, 5…
## $ week_22                              <dbl> 20, -5, 5, 0, 20, 5, -1, 0, 0, 20…
## $ week_23                              <dbl> 5, 1, -3, 20, -5, 20, 0, 1, 1, 5,…
## $ week_24                              <dbl> 10, -20, -20, 0, 10, 5, 5, -3, -5…
## $ week_25                              <dbl> 0, -20, 1, 3, 5, 1, -5, 0, -20, 2…
## $ week_26                              <dbl> 10, 10, 5, -1, 0, 5, 5, -3, 0, 20…
## $ week_27                              <dbl> 5, 5, -3, 0, 20, 5, 0, -5, 10, 3,…
## $ week_28                              <dbl> -3, 20, 20, 1, 10, 5, 1, 10, 0, 1…
## $ week_29                              <dbl> -20, -5, 5, 5, -10, 1, 0, -3, 0, …
## $ week_30                              <dbl> 5, 1, -5, 5, -5, -1, -20, 20, 1, …
## $ week_31                              <dbl> 5, 5, 20, -5, -10, -3, 0, -10, 20…
## $ week_32                              <dbl> -5, 1, 20, -1, -10, 5, 10, 1, 0, …
## $ week_33                              <dbl> 0, 10, 3, 3, 0, 0, -1, 0, -20, 3,…
## $ week_34                              <dbl> 0, -1, 0, 0, 10, 3, 20, -5, 10, 3…
## $ week_35                              <dbl> 5, -5, 3, -10, 3, -5, 0, 0, 0, 0,…
## $ week_36                              <dbl> 1, 5, 1, -20, 5, 20, -1, -3, 1, 3…
## $ week_37                              <dbl> 0, 0, 10, -1, 10, 3, 3, 0, 20, 1,…
## $ week_38                              <dbl> 10, -1, 0, -5, 5, 5, 20, -5, -3, …
## $ week_39                              <dbl> 3, 5, 1, 10, 20, 0, 5, 1, -5, 0, …
## $ week_40                              <dbl> 0, 0, 5, 1, 5, 1, 10, -5, -20, 3,…
# Changing some variables type to factors
hogwarts <- hogwarts |> mutate(
  across(c(house, course, sex, wandCore, bloodStatus), ~ as.factor(.x))
)

Поиск пропущенных значений

sum(is.na(hogwarts))
## [1] 0

Сводка по данным

hogwarts |> 
  summary()
##        id               house     course      sex                    wandCore  
##  Min.   :  1.0   Gryffindor:126   1: 80   female:333   dragon heartstring:196  
##  1st Qu.:140.8   Hufflepuff:179   2:101   male  :227   phoenix feather   :181  
##  Median :280.5   Ravenclaw :122   3: 67                unicorn hair      :183  
##  Mean   :280.5   Slytherin :133   4: 71                                        
##  3rd Qu.:420.2                    5: 88                                        
##  Max.   :560.0                    6: 67                                        
##                                   7: 86                                        
##       bloodStatus      result        Defence against the dark arts exam
##  half-blood :391   Min.   :-292.00   Min.   : 0                        
##  muggle-born: 60   1st Qu.:   7.00   1st Qu.:39                        
##  pure-blood :109   Median :  70.50   Median :49                        
##                    Mean   :  59.71   Mean   :48                        
##                    3rd Qu.: 128.25   3rd Qu.:58                        
##                    Max.   : 260.00   Max.   :89                        
##                                                                        
##   Flying exam    Astronomy exam  Herbology exam  Divinations exam
##  Min.   : 0.00   Min.   : 0.00   Min.   : 0.00   Min.   : 0.00   
##  1st Qu.:36.00   1st Qu.:37.00   1st Qu.:39.00   1st Qu.:38.00   
##  Median :48.00   Median :49.00   Median :49.00   Median :49.00   
##  Mean   :47.37   Mean   :47.99   Mean   :47.75   Mean   :48.44   
##  3rd Qu.:60.00   3rd Qu.:60.00   3rd Qu.:58.00   3rd Qu.:59.00   
##  Max.   :85.00   Max.   :87.00   Max.   :86.00   Max.   :89.00   
##                                                                  
##   Charms exam    History of magic exam Arithmancy exam
##  Min.   : 0.00   Min.   : 0.00         Min.   : 0.00  
##  1st Qu.:39.00   1st Qu.:37.00         1st Qu.:38.00  
##  Median :49.00   Median :48.00         Median :50.00  
##  Mean   :48.36   Mean   :47.28         Mean   :48.38  
##  3rd Qu.:59.00   3rd Qu.:58.00         3rd Qu.:60.00  
##  Max.   :98.00   Max.   :85.00         Max.   :91.00  
##                                                       
##  Care of magical creatures exam Muggle studies exam Study of ancient runes exam
##  Min.   : 0.00                  Min.   : 0.00       Min.   : 0.00              
##  1st Qu.:38.00                  1st Qu.:38.00       1st Qu.:38.00              
##  Median :49.00                  Median :50.00       Median :48.00              
##  Mean   :48.11                  Mean   :48.64       Mean   :47.44              
##  3rd Qu.:60.00                  3rd Qu.:61.00       3rd Qu.:58.00              
##  Max.   :95.00                  Max.   :94.00       Max.   :89.00              
##                                                                                
##  Transfiguration exam  Potions exam        week_1            week_2       
##  Min.   :  0.00       Min.   :  0.00   Min.   :-20.000   Min.   :-20.000  
##  1st Qu.: 34.00       1st Qu.: 21.00   1st Qu.: -3.000   1st Qu.: -3.000  
##  Median : 49.00       Median : 47.00   Median :  1.000   Median :  1.000  
##  Mean   : 48.24       Mean   : 46.62   Mean   :  1.334   Mean   :  1.161  
##  3rd Qu.: 62.25       3rd Qu.: 68.00   3rd Qu.:  5.000   3rd Qu.:  5.000  
##  Max.   :100.00       Max.   :100.00   Max.   : 50.000   Max.   : 20.000  
##                                                                           
##      week_3            week_4           week_5             week_6       
##  Min.   :-20.000   Min.   :-20.00   Min.   :-20.0000   Min.   :-20.000  
##  1st Qu.: -1.500   1st Qu.: -1.00   1st Qu.: -3.0000   1st Qu.: -1.000  
##  Median :  1.000   Median :  1.00   Median :  1.0000   Median :  1.000  
##  Mean   :  1.407   Mean   :  1.82   Mean   :  0.9196   Mean   :  1.448  
##  3rd Qu.:  5.000   3rd Qu.:  5.00   3rd Qu.:  5.0000   3rd Qu.:  5.000  
##  Max.   : 20.000   Max.   : 20.00   Max.   : 20.0000   Max.   : 20.000  
##                                                                         
##      week_7            week_8          week_9          week_10       
##  Min.   :-20.000   Min.   :-20.0   Min.   :-50.00   Min.   :-20.000  
##  1st Qu.: -3.000   1st Qu.: -1.0   1st Qu.: -1.00   1st Qu.: -1.000  
##  Median :  1.000   Median :  1.0   Median :  1.00   Median :  1.000  
##  Mean   :  1.529   Mean   :  1.6   Mean   :  1.63   Mean   :  1.457  
##  3rd Qu.:  5.000   3rd Qu.:  5.0   3rd Qu.:  5.00   3rd Qu.:  5.000  
##  Max.   : 20.000   Max.   : 20.0   Max.   : 20.00   Max.   : 20.000  
##                                                                      
##     week_11           week_12           week_13            week_14      
##  Min.   :-20.000   Min.   :-20.000   Min.   :-20.0000   Min.   :-20.00  
##  1st Qu.: -1.000   1st Qu.: -1.000   1st Qu.: -3.0000   1st Qu.: -1.00  
##  Median :  1.000   Median :  1.000   Median :  0.0000   Median :  1.00  
##  Mean   :  1.586   Mean   :  1.689   Mean   :  0.7393   Mean   :  1.53  
##  3rd Qu.:  5.000   3rd Qu.:  5.000   3rd Qu.:  5.0000   3rd Qu.:  5.00  
##  Max.   : 20.000   Max.   : 20.000   Max.   : 50.0000   Max.   : 20.00  
##                                                                         
##     week_15           week_16           week_17         week_18       
##  Min.   :-20.000   Min.   :-20.000   Min.   :-20.0   Min.   :-20.000  
##  1st Qu.: -1.000   1st Qu.: -1.000   1st Qu.: -1.0   1st Qu.: -1.000  
##  Median :  1.000   Median :  1.000   Median :  1.0   Median :  1.000  
##  Mean   :  1.738   Mean   :  1.636   Mean   :  1.8   Mean   :  1.712  
##  3rd Qu.:  5.000   3rd Qu.:  5.000   3rd Qu.:  5.0   3rd Qu.:  5.000  
##  Max.   : 20.000   Max.   : 20.000   Max.   : 50.0   Max.   : 20.000  
##                                                                       
##     week_19            week_20          week_21           week_22       
##  Min.   :-50.0000   Min.   :-20.00   Min.   :-20.000   Min.   :-20.000  
##  1st Qu.: -3.0000   1st Qu.: -3.00   1st Qu.: -1.000   1st Qu.: -1.000  
##  Median :  0.0000   Median :  1.00   Median :  1.000   Median :  1.000  
##  Mean   :  0.8071   Mean   :  1.55   Mean   :  1.816   Mean   :  1.527  
##  3rd Qu.:  5.0000   3rd Qu.:  5.00   3rd Qu.:  5.000   3rd Qu.:  5.000  
##  Max.   : 20.0000   Max.   : 50.00   Max.   : 20.000   Max.   : 20.000  
##                                                                         
##     week_23            week_24           week_25           week_26       
##  Min.   :-20.0000   Min.   :-20.000   Min.   :-20.000   Min.   :-20.000  
##  1st Qu.: -3.0000   1st Qu.: -1.000   1st Qu.: -3.000   1st Qu.: -3.000  
##  Median :  0.0000   Median :  1.000   Median :  1.000   Median :  1.000  
##  Mean   :  0.8036   Mean   :  1.168   Mean   :  1.364   Mean   :  1.248  
##  3rd Qu.:  5.0000   3rd Qu.:  5.000   3rd Qu.:  5.000   3rd Qu.:  5.000  
##  Max.   : 20.0000   Max.   : 20.000   Max.   : 20.000   Max.   : 20.000  
##                                                                          
##     week_27         week_28           week_29           week_30       
##  Min.   :-50.0   Min.   :-20.000   Min.   :-20.000   Min.   :-20.000  
##  1st Qu.: -1.0   1st Qu.: -1.500   1st Qu.: -1.000   1st Qu.: -1.000  
##  Median :  1.0   Median :  1.000   Median :  0.000   Median :  1.000  
##  Mean   :  1.5   Mean   :  1.923   Mean   :  1.262   Mean   :  1.705  
##  3rd Qu.:  5.0   3rd Qu.:  5.000   3rd Qu.:  5.000   3rd Qu.:  5.000  
##  Max.   : 20.0   Max.   : 20.000   Max.   : 20.000   Max.   : 20.000  
##                                                                       
##     week_31          week_32           week_33           week_34       
##  Min.   :-20.00   Min.   :-20.000   Min.   :-20.000   Min.   :-20.000  
##  1st Qu.: -1.00   1st Qu.: -1.000   1st Qu.: -1.000   1st Qu.: -1.000  
##  Median :  1.00   Median :  1.000   Median :  1.000   Median :  1.000  
##  Mean   :  1.68   Mean   :  2.013   Mean   :  1.539   Mean   :  1.593  
##  3rd Qu.:  5.00   3rd Qu.:  5.000   3rd Qu.:  5.000   3rd Qu.:  5.000  
##  Max.   : 20.00   Max.   : 20.000   Max.   : 20.000   Max.   : 20.000  
##                                                                        
##     week_35         week_36           week_37          week_38       
##  Min.   :-20.0   Min.   :-20.000   Min.   :-20.00   Min.   :-20.000  
##  1st Qu.: -1.0   1st Qu.: -1.000   1st Qu.: -1.00   1st Qu.: -1.000  
##  Median :  1.0   Median :  1.000   Median :  1.00   Median :  1.000  
##  Mean   :  1.7   Mean   :  2.079   Mean   :  1.32   Mean   :  1.864  
##  3rd Qu.:  5.0   3rd Qu.:  5.000   3rd Qu.:  5.00   3rd Qu.:  5.000  
##  Max.   : 20.0   Max.   : 20.000   Max.   : 20.00   Max.   : 20.000  
##                                                                      
##     week_39           week_40       
##  Min.   :-20.000   Min.   :-20.000  
##  1st Qu.: -1.000   1st Qu.: -3.000  
##  Median :  1.000   Median :  0.000  
##  Mean   :  1.438   Mean   :  1.079  
##  3rd Qu.:  5.000   3rd Qu.:  5.000  
##  Max.   : 20.000   Max.   : 20.000  
## 

Пересоздание theme_custom

theme_custom <- theme(
    panel.background = element_rect(fill = "white"),
    plot.title = element_text(size = 30, hjust = 0.5),
    plot.subtitle = element_text(size = 25, hjust = 0.5),
    strip.text = element_text(size = 20),
    axis.text = element_text(size = 20),
    axis.title = element_text(size = 25),
    legend.title = element_text(size = 25),
    legend.text = element_text(size = 20)
  )

# А еще мы создаем функцию для стандартной ошибки среднего
se <- function(x){
  sd(x, na.rm=TRUE)/sqrt(length(x))
}

Диаграммы рассеяния (скаттерплоты)

1. Постройте скаттерплот, визуализирующий связь между суммарным баллом студента за год и оценкой за экзамен по травологии.

Добавьте на график линию тренда. Удалите доверительную область и сделайте линию прямой. Подумайте, как избежать того, чтобы записать одни и те же координаты x и y дважды. Проинтерпретируйте график. (1 б.)

hogwarts |> 
 ggplot(aes(x = `Herbology exam`, y = `result`)) +
  geom_point() +
  geom_smooth(method = "lm", se = FALSE) +
  labs(
    x = "Оценка на экзамене по Травологии",
    y = "Общий результат",
    title = "Зависимость общего результата от оценки по Травологии"
  ) +
  annotate("text", 
           x = 75, y = 150, 
           label = "Линия тренда", 
           color = "blue", 
           size = 7,
           hjust = 0) +
  theme_custom

Интерпретация: наклон линии вверх указывает на положительную корреляцию: чем выше оценка на экзамене по травологии, тем выше общий результат студента. О мере взаимосвязи (силе корреляции) мы судить из графика не можем, так как для этого необходимо применение критерия, но скорее всего связь будет достаточно выраженная.

2. Отобразите на одном графике скаттерплоты для экзаменов по травологии, магловедению, прорицаниям и зельеварению.

На графике так же должна присутствовать линия тренда с характеристиками, аналогичными тем, что были в пункте 1. Раскрасьте точки на графике в разные цвета, в соответствии с факультетами. Используйте стандартные цвета факультетов (как в лекционных rmd). Проинтерпретируйте график. (1 б). Если вы создадите график из этого пункта, используя только пакеты семейства tidyverse, и не привлекая дополнительные средства, вы получите дополнительные 0.5 б.

theme_custom2 <-  theme(
    panel.background = element_rect(fill = "white"),
    plot.title = element_text(size = 30, hjust = 0.5),
    plot.subtitle = element_text(size = 25, hjust = 0.5),
    strip.text = element_text(size = 20),
    axis.text = element_text(size = 20),
    axis.title = element_text(size = 25),
    legend.title = element_text(size = 25),
    legend.text = element_text(size = 20),
    legend.position = c(0.15, 0.8)
  )

# Зависимость общего результата от оценки по Травологии
HerbologyResults <- hogwarts |> 
  ggplot(aes(x = `Herbology exam`, y = `result`)) +
  geom_point(aes(color = house, alpha = 0.6)) +
  geom_smooth(method = "lm", se = FALSE, color = "black") + 
  scale_color_manual(
    name = "Факультет",
    values = c(
      "Gryffindor" = "#C50000", 
      "Hufflepuff" = "#ECB939", 
      "Ravenclaw" = "#41A6D9", 
      "Slytherin" = "#1F5D25"
    ),
    labels = c("Гриффиндор", "Пуффендуй", "Когтевран", "Слизерин")) +
  labs(
    x = "Оценка на экзамене",
    y = "Общий результат",
    title = "Зависимость общей оценки от Травологии"
  ) +
  guides(alpha = "none") +
  theme_custom2
# Зависимость общего результата от оценки по Магловедению
MuggleResults <- hogwarts |> 
  ggplot(aes(x = `Muggle studies exam`, y = `result`)) +
  geom_point(aes(color = house, alpha = 0.6)) +
  geom_smooth(method = "lm", se = FALSE, color = "black") + 
  scale_color_manual(
    name = "Факультет",
    values = c(
      "Gryffindor" = "#C50000", 
      "Hufflepuff" = "#ECB939", 
      "Ravenclaw" = "#41A6D9", 
      "Slytherin" = "#1F5D25"
    ),
    labels = c("Гриффиндор", "Пуффендуй", "Когтевран", "Слизерин")) +
  labs(
    x = "Оценка на экзамене",
    y = "Общий результат",
    title = "Зависимость общей оценки от  Магловедению"
  ) +
  guides(alpha = "none") +
  theme_custom2
# Зависимость общего результата от оценки по Прорицаниям
DivinationsResults <- hogwarts |> 
  ggplot(aes(x = `Divinations exam` , y = `result`)) +
  geom_point(aes(color = house, alpha = 0.6)) +
  geom_smooth(method = "lm", se = FALSE, color = "black") + 
  scale_color_manual(
    name = "Факультет",
    values = c(
      "Gryffindor" = "#C50000", 
      "Hufflepuff" = "#ECB939", 
      "Ravenclaw" = "#41A6D9", 
      "Slytherin" = "#1F5D25"
    ),
    labels = c("Гриффиндор", "Пуффендуй", "Когтевран", "Слизерин")) +
  labs(
    x = "Оценка на экзамене",
    y = "Общий результат",
    title = "Зависимость общей оценки от Прорицаниям"
  ) +
  guides(alpha = "none") +
  theme_custom2
# Зависимость общего результата от оценки по Зельеварению
PotionsResults <- hogwarts |> 
  ggplot(aes(x = `Potions exam`, y = `result`)) +
  geom_point(aes(color = house, alpha = 0.6)) +
  geom_smooth(method = "lm", se = FALSE, color = "black") + 
  scale_color_manual(
    name = "Факультет",
    values = c(
      "Gryffindor" = "#C50000", 
      "Hufflepuff" = "#ECB939", 
      "Ravenclaw" = "#41A6D9", 
      "Slytherin" = "#1F5D25"
    ),
    labels = c("Гриффиндор", "Пуффендуй", "Когтевран", "Слизерин")) +
  labs(
    x = "Оценка на экзамене",
    y = "Общий результат",
    title = "Зависимость общей оценки от Зельеварению"
  ) +
  guides(alpha= "none", color= "none") +
  theme_custom2

Комбинируем графики

ggarrange(plotlist = list(HerbologyResults, MuggleResults, DivinationsResults, PotionsResults),
          ncol = 2, 
          nrow = 2)

Примечание: с последнего графика была удалена легенда, так как она мешала восприятию графика

Интерпретация графиков: Мы видим, что зависимость общей оценки от оценки по трем предметам, Травологии, Магловедению и Прорицаниям, примерно похожая. Есть линейная зависимость оценки по этим предметам от общей оценки. Также студенты Когтеврана группируются в числе лучших, как и по общей успеваемости, так и по успеваемости по отдельным предметам. Студенты Пуффендуя и Гриффиндора группируются равномерно вдоль линии тренда, а студенты Слизерина делятся на две группы: успевающих очень хорошо и успевающих рекордно плохо (даже с отрицательной общей оценкой).

Линейной зависимости оценки по Зельеварению от общей оценки не наблюдается. Также заметно, что в первый квартиль по успеваемости попадают только студенты Слизерина, причем только туда. Это объяснимо известной тягой профессора Снейпа симпатизировать студентам своего факультета и завышать им оценки по своему предмету.

3. Видоизмените предыдущий график.

Сгруппируйте и покрасьте линии тренда в соответствии с одной из категориальных переменных (с такой, которая подсвечивает одно из наблюдений на предыдущем этапе, относящееся ко всем 4-м экзаменам). Постарайтесь избежать коллизий в легенде, при этом сохранив и цветовую палитру для раскраски точек по факультетам. (1 б.)

С какой переменной? Факультет, пол или начинка палочки?

Допустим для пола:

# Зависимость общего результата от оценки по Травологии
HerbologyResults2 <- hogwarts |> 
  ggplot(aes(x = `Herbology exam`, y = `result`)) +
  geom_point(aes(color = house, alpha = 0.6)) +
  geom_smooth(aes(color = sex), 
              method = "lm", se = FALSE) +
  scale_color_manual(
    name = "Факультет и пол",
    values = c(
      "Gryffindor" = "#C50000", 
      "Hufflepuff" = "#ECB939", 
      "Ravenclaw" = "#41A6D9", 
      "Slytherin" = "#1F5D25",
      "male" = "black",
      "female" = "purple4"   
    ),
    labels = c("Гриффиндор", "Пуффендуй", "Когтевран", "Слизерин", "Мужской", "Женский")
  ) +
  labs(
    x = "Оценка на экзамене",
    y = "Общий результат",
    title = "Зависимость общей оценки от Травологии"
  ) +
  guides(alpha = "none") +
  theme_custom2
# Зависимость общего результата от оценки по Магловедению
MuggleResults2 <- hogwarts |> 
  ggplot(aes(x = `Muggle studies exam`, y = `result`)) +
  geom_point(aes(color = house, alpha = 0.6)) +
geom_smooth(aes(color = sex), 
              method = "lm", se = FALSE) +
  scale_color_manual(
    name = "Факультет и пол",
    values = c(
      "Gryffindor" = "#C50000", 
      "Hufflepuff" = "#ECB939", 
      "Ravenclaw" = "#41A6D9", 
      "Slytherin" = "#1F5D25",
      "male" = "black",
      "female" = "purple4"   
    ),
    labels = c("Гриффиндор", "Пуффендуй", "Когтевран", "Слизерин", "Мужской", "Женский")
  ) +
  labs(
    x = "Оценка на экзамене",
    y = "Общий результат",
    title = "Зависимость общей оценки от  Магловедению"
  ) +
  guides(alpha = "none") +
  theme_custom2
# Зависимость общего результата от оценки по Прорицаниям
DivinationsResults2 <- hogwarts |> 
  ggplot(aes(x = `Divinations exam` , y = `result`)) +
  geom_point(aes(color = house, alpha = 0.6)) +
  geom_smooth(aes(color = sex), 
              method = "lm", se = FALSE) +
  scale_color_manual(
    name = "Факультет и пол",
    values = c(
      "Gryffindor" = "#C50000", 
      "Hufflepuff" = "#ECB939", 
      "Ravenclaw" = "#41A6D9", 
      "Slytherin" = "#1F5D25",
      "male" = "black",
      "female" = "purple4"   
    ),
    labels = c("Гриффиндор", "Пуффендуй", "Когтевран", "Слизерин", "Мужской", "Женский")
  ) +
  labs(
    x = "Оценка на экзамене",
    y = "Общий результат",
    title = "Зависимость общей оценки от Прорицаниям"
  ) +
  guides(alpha = "none") +
  theme_custom2
# Зависимость общего результата от оценки по Зельеварению
PotionsResults2 <- hogwarts |> 
  ggplot(aes(x = `Potions exam`, y = `result`)) +
  geom_point(aes(color = house, alpha = 0.6)) +
  geom_smooth(aes(color = sex), 
              method = "lm", se = FALSE) +
  scale_color_manual(
    name = "Факультет и пол",
    values = c(
      "Gryffindor" = "#C50000", 
      "Hufflepuff" = "#ECB939", 
      "Ravenclaw" = "#41A6D9", 
      "Slytherin" = "#1F5D25",
      "male" = "black",
      "female" = "purple4"   
    ),
    labels = c("Гриффиндор", "Пуффендуй", "Когтевран", "Слизерин", "Мужской", "Женский")
  ) +
  labs(
    x = "Оценка на экзамене",
    y = "Общий результат",
    title = "Зависимость общей оценки от Зельеварению"
  ) +
  guides(alpha= "none") +
  theme_custom2

ggarrange(plotlist = list(HerbologyResults2, MuggleResults2, DivinationsResults2, PotionsResults2),
          ncol = 2, 
          nrow = 2)

Примечание: как сделать так, чтобы сохранился color code и у точек, и у линий, и чтобы было две разных легенды - я так и не поняла…

Интерпретация: по трем первым предметам зависимость у мужчин и у женщин однонаправленная, но с разным уклоном: судя по графикам, мальчики получают общие отрицательные оценки, а девочки - нет.

Судя по графику с зельевареньем, группа неуспевающих слизеринцев - исключительно мальчики, а слизеринцы с хорошими итоговыми баллами - исключительно слизеринки.

Проверим гипотезу, изменив точки на графике с зельевареньем в соответствии с полом.

hogwarts |> 
  ggplot(aes(x = `Potions exam`, y = `result`)) +
  geom_point(aes(color = house, shape = sex, size = 1, alpha = 0.6)) +
  geom_smooth(aes(color = sex), 
              method = "lm", se = FALSE) +
  scale_color_manual(
    name = "Факультет и пол",
    values = c(
      "Gryffindor" = "#C50000", 
      "Hufflepuff" = "#ECB939", 
      "Ravenclaw" = "#41A6D9", 
      "Slytherin" = "#1F5D25",
      "male" = "black",
      "female" = "purple4"   
    ),
    labels = c("Гриффиндор", "Пуффендуй", "Когтевран", "Слизерин", "Мужской", "Женский")
  ) +
  labs(
    x = "Оценка на экзамене",
    y = "Общий результат",
    title = "Зависимость общей оценки от Зельеварению"
  ) +
  guides(alpha= "none") +
  theme_custom

И сделаем то же самое для всех графиков

geom_col и вещи вокруг него

1. Постройте барплот (столбиковую диаграмму) распредления набранных баллов за первый семестр (с 1-й по 17-ю неделю включительно) у студентов разного происхождения.

Выдвиньте гипотезу (или гипотезы), почему распределение получилось именно таким. (1 б.)

houseResult <- hogwarts |> 
  group_by(house) |> 
  summarise(houseTotalPoints = sum(result))

ggplot(houseResult)+
  geom_col(aes(x = fct_reorder(house, houseTotalPoints, .desc = TRUE), 
               y = houseTotalPoints,
               fill = house))+
  scale_fill_manual(values = c("Gryffindor" = "#C50000", 
                             "Hufflepuff" = "#ECB939", 
                             "Ravenclaw" = "#41A6D9", 
                             "Slytherin" = "#1F5D25"))+
  xlab(label = "house")+
  theme_custom

А если мы хотим визуализировать не количество?

houseResult <- hogwarts |> 
  group_by(house) |> 
  summarise(houseTotalPoints = sum(result))

ggplot(houseResult)+
  geom_col(aes(x = fct_reorder(house, houseTotalPoints, .desc = TRUE), 
               y = houseTotalPoints,
               fill = house))+
  scale_fill_manual(values = c("Gryffindor" = "#C50000", 
                             "Hufflepuff" = "#ECB939", 
                             "Ravenclaw" = "#41A6D9", 
                             "Slytherin" = "#1F5D25"))+
  xlab(label = "house")+
  theme_custom

houseResult <- hogwarts |> 
  group_by(house, wandCore) |> 
  summarise(houseTotalPoints = sum(result)) |> 
  mutate(`house and wnad core` = paste0(house, " & ", wandCore))

house_wand_result_plot <- ggplot(houseResult)+
  geom_col(aes(y = fct_reorder(`house and wnad core`, houseTotalPoints, .desc = FALSE), 
               x = houseTotalPoints,
               fill = house))+
  labs(title = "Распределение очков факультета\nв зависимости от факультета и волшебной палочки",
       subtitle = "Учебный год 2023/2024",
       caption = "Данные предоставлены Институтом биоинформатики",
       x = "Очки",
       y = "Факультет и палочка",
       fill = "Факультет")+
  scale_fill_manual(labels = c("Gryffindor" = "Гриффиндор", 
                             "Hufflepuff" = "Пуффендуй", 
                             "Ravenclaw" = "Когтевран", 
                             "Slytherin" = "Слизерин"),
                    values = c("Gryffindor" = "#C50000", 
                             "Hufflepuff" = "#ECB939", 
                             "Ravenclaw" = "#41A6D9", 
                             "Slytherin" = "#1F5D25")
                    )+
  scale_x_continuous(breaks = seq(0,6000,l=7))+
  theme_custom

house_wand_result_plot

Текстовые метки

house_wand_result_plot+
  geom_text(aes(y = fct_reorder(`house and wnad core`, houseTotalPoints, .desc = FALSE), 
               x = houseTotalPoints,
               label = paste0(houseTotalPoints, " points")),
            colour = "black",
            size = 8,
            hjust = -1)+
  xlim(0, 10000)

Вредные советы

Посмотрим на другое представление данных по факультетам.

houseCountDf <- hogwarts |> 
  group_by(house) |> 
  summarise(count = n())

pieTestPlot <- ggplot(houseCountDf)+
  geom_col(aes(x = "",
               y = count, 
               fill = house))+
  coord_polar(theta = "y")+
  scale_fill_manual(values = c("Gryffindor" = "#C50000", 
                             "Hufflepuff" = "#ECB939", 
                             "Ravenclaw" = "#41A6D9", 
                             "Slytherin" = "#1F5D25"))+
  theme_custom

barTestPlot <- ggplot(hogwarts)+
  geom_bar(aes(x = fct_infreq(house), 
               fill = house))+
  scale_fill_manual(values = c("Gryffindor" = "#C50000", 
                           "Hufflepuff" = "#ECB939", 
                           "Ravenclaw" = "#41A6D9", 
                           "Slytherin" = "#1F5D25"))+
  xlab(label = "house")+
  theme_custom

ggarrange(plotlist = list(pieTestPlot, barTestPlot), ncol = 2)

Попробуем взять средние.

housePotionsExam <- hogwarts |> 
  group_by(house) |> 
  summarise(meanPotionsExam = mean(`Potions exam`))

ggplot(housePotionsExam)+
  geom_col(aes(x = house, 
               y = meanPotionsExam,
               fill = house))+
  scale_fill_manual(values = c("Gryffindor" = "#C50000", 
                             "Hufflepuff" = "#ECB939", 
                             "Ravenclaw" = "#41A6D9", 
                             "Slytherin" = "#1F5D25"))+
  theme_custom

Интервалы

housePotionsExam <- hogwarts |> 
  group_by(house) |> 
  summarise(meanPotionsExam = mean(`Potions exam`) |> round(2),
            ci95Min = (min(`Potions exam`) |> round(2)),
            ci95Max = (max(`Potions exam`) |> round(2)))

ggplot(housePotionsExam, aes(x = house, 
               y = meanPotionsExam))+
  # geom_point(aes(colour = house),
  #            size = 3)+
  geom_pointrange(aes(ymin = ci95Min,
                      ymax = ci95Max, 
                    colour = house),
                # width = 0.3,
                linewidth = 2,
                fatten = 7)+
  ylim(0, 100)+
  theme_custom